home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / AMIGA / AMICUS / AMIBEST1.ADF / AmigaBasicStuff / HouseHold / HouseInvMaint < prev    next >
Text File  |  1987-07-22  |  11KB  |  420 lines
  1. ' The Household Inventory File Maintenance Program
  2. ' ------------------------------------------------
  3. ' This is Program #3 of 3: :"HouseInvMaint" -file maintenance
  4. ' Program #1 is the "HouseInv" (main) program
  5. ' Program #2 is the "HouseInvPrint" program
  6. '
  7. ' Please do not modify the title screen in any way.
  8. ' January 1987
  9. '
  10. numbx=4:RecCnt=0:NewCnt=0:m=0:i=0:ErrSw=0:type=0
  11. A%=0:B%=0
  12. DIM bx(numbx-1,6),bxtxt$(numbx-1)
  13. Logo80 3
  14. BldGadgets numbx,bx(),bxtxt$()
  15. ' No and OK Gadgets
  16. DATA  28, 36,24,16,7,4,0,"No"
  17. DATA 116, 36,24,16,7,2,0,"Ok"
  18. ' Help Gadgets
  19. DATA  36,172,40,16,7,4,0,"More"
  20. DATA 156,172,40,16,7,2,0," Ok"
  21. InA%=0:InB%=1
  22. HlpA%=2:HlpB%=3
  23. COLOR Blu,Blk
  24. LOCATE  9,39:PRINT"THE"
  25. LOCATE 11,22:PRINT"H O U S E H O L D   I N V E N T O R Y"
  26. LOCATE 13,38:PRINT"SYSTEM"
  27. COLOR Mag,Blk
  28. LOCATE 16,25:PRINT"F I L E   M A I N T E N A N C E"
  29. MENU 1,0,1,"Project:"
  30. MENU 1,1,1,"Quit    "
  31. MENU 2,0,1,"Help:"
  32. MENU 2,1,1,"General     "
  33. MENU 2,2,1,"Initialize  "
  34. MENU 2,3,1,"Reorganize  "
  35. MENU 2,4,1,"Record Count"
  36. MENU 2,5,1,"Update Count"
  37. MENU 3,0,1,"Maintenance:"
  38. MENU 3,1,1,"Initialize  "
  39. MENU 3,2,1,"Reorganize  "
  40. MENU 3,3,1,"Record Count"
  41. MENU 3,4,1,"Update Count"
  42. MENU 4,0,0,""
  43. ON ERROR GOTO InitError
  44. ErrSw=0:GOSUB GetRecCnt
  45. InitCont:
  46. ON ERROR GOTO 0
  47. IF ErrSw=1 THEN ErrSw=0:RecCnt=0:GOSUB PutRecCnt
  48. ON MOUSE GOSUB GetMouse
  49. ON MENU GOSUB GetMenu
  50. COLOR Yel,Blk:LOCATE 21,23
  51. PRINT"Use Menus to select program function"
  52. WaitHere:
  53. MENU ON:m=0:i=0:WHILE m=0:SLEEP:WEND
  54. MENU OFF:ON m GOTO Quit,Help,Maintain
  55.  
  56. ' Count File Error Routine
  57. ' ------------------------
  58. InitError:
  59. WINDOW 2
  60. IF ERR=53 THEN
  61.   ErrSw=1:RESUME InitCont
  62. ELSE
  63.   ON ERROR GOTO 0
  64. END IF
  65.  
  66. ' Menu Event Routine
  67. ' ------------------
  68. GetMenu:
  69. m=MENU(0):i=MENU(1)
  70. RETURN
  71.  
  72. ' Mouse Event Routine
  73. ' -------------------
  74. GetMouse:
  75. GetGadget A%,B%,bx(),bxtxt$(),type
  76. RETURN
  77.  
  78. ' Wait for Mouse Click
  79. ' --------------------
  80. WaitMouse:
  81. MOUSE ON
  82. type=0:WHILE type=0:SLEEP:WEND
  83. MOUSE OFF
  84. RETURN
  85.  
  86. ' Open Main Data File
  87. ' -------------------
  88. Opendata:
  89. IF RecCnt=0 THEN
  90.   WINDOW 3,,(440,40)-(608,96),0,1
  91.   COLOR Blu,Yel:CLS
  92.   LOCATE 2,3:PRINT"File  is   empty."
  93.   DrawGadgets InB%,InB%,bx(),bxtxt$()
  94.   A%=InB%:B%=InB%:GOSUB WaitMouse
  95.   ErrSw=1:WINDOW CLOSE 3
  96.   GOTO ODXit
  97. END IF
  98. OPEN "R",#1,"HouseInv.Data",103
  99. FIELD #1,1 AS d1$,10 AS d2$,15 AS d3$,8 AS d4$,6 AS d5$,6 AS d6$,6 AS d7$,15 AS d8$,20 AS d9$,8 AS d10$,8 AS d11$
  100. ErrSw=0
  101. ODXit:
  102. RETURN
  103.  
  104. ' Open Temporary Data File
  105. ' ------------------------
  106. OpenTemp:
  107. OPEN "R",#9,"Temp.Data",103
  108. FIELD #9,1 AS t1$,10 AS t2$,15 AS t3$,8 AS t4$,6 AS t5$,6 AS t6$,6 AS t7$,15 AS t8$,20 AS t9$,8 AS t10$,8 AS t11$
  109. RETURN
  110.  
  111. ' Get Record Count
  112. ' ----------------
  113. GetRecCnt:
  114. OPEN"HouseInv.Count" FOR INPUT AS #2
  115. INPUT #2,RecCnt
  116. CLOSE #2
  117. RETURN
  118.  
  119. ' Update Record Count
  120. ' -------------------
  121. PutRecCnt:
  122. WINDOW 3,,(440,40)-(608,96),0,1
  123. COLOR Blu,Yel:CLS
  124. LOCATE 2,4:PRINT"Updating Count"
  125. LOCATE 3,4:PRINT"File."
  126. OPEN"HouseInv.Count" FOR OUTPUT AS #2
  127. WRITE #2,RecCnt
  128. CLOSE #2
  129. WINDOW CLOSE 3
  130. RETURN
  131.  
  132. ' Time to Quit and Return to Basic
  133. ' --------------------------------
  134. Quit:
  135. MENU RESET
  136. WINDOW CLOSE 2:SCREEN CLOSE 1
  137. END
  138.  
  139. ' Help Routines
  140. ' -------------
  141. Help:
  142. GOSUB DoHelp
  143. GOTO WaitHere
  144.  
  145. ' Data File Maintenance Routines
  146. ' ------------------------------
  147. Maintain:
  148. ON i GOTO MInit,MReorg,MRecCount,MUpdCount
  149.  
  150. ' Initialize the Count File to Zero
  151. MInit:
  152. WINDOW 3,,(440,40)-(608,92),0,1
  153. COLOR Blu,Yel:CLS
  154. LOCATE 2,3:PRINT"This  option  will"
  155. LOCATE 3,3:PRINT"delete any records"
  156. LOCATE 4,3:PRINT"on file."
  157. DrawGadgets InA%,InB%,bx(),bxtxt$()
  158. A%=InA%:B%=InB%:GOSUB WaitMouse
  159. WINDOW CLOSE 3
  160. ON type GOTO MInXit,MInOK
  161. MInOK:
  162. IF RecCnt>0 THEN
  163.   KILL"houseInv.Data":KILL"HouseInv.Data.info"
  164. END IF
  165. RecCnt=0:GOSUB PutRecCnt
  166. MInXit:
  167. GOTO MaintXit
  168.  
  169. ' Reorganize the Data File
  170. MReorg:
  171. GOSUB Opendata:IF ErrSw=1 THEN MRXit
  172. WINDOW 3,,(440,40)-(608,92),0,1
  173. COLOR Blu,Yel:CLS
  174. LOCATE 2,3:PRINT"Reorganizing  the"
  175. LOCATE 3,3:PRINT"Data File."
  176. GOSUB OpenTemp:NewCount=0
  177. FOR n=1 TO RecCnt
  178.   GET #1,n
  179.   IF d1$="0" THEN
  180.     NewCnt=NewCnt+1
  181.     LSET t1$=d1$:LSET t2$=d2$:LSET t3$=d3$:LSET t4$=d4$
  182.     LSET t5$=d5$:LSET t6$=d6$:LSET t7$=d7$:LSET t8$=d8$
  183.     LSET t9$=d9$:LSET t10$=d10$:LSET t11$=d11$
  184.     PUT #9,NewCnt
  185.   END IF
  186. NEXT
  187. CLOSE #1:CLOSE #9
  188. KILL"HouseInv.Data.info":KILL"HouseInv.Data"
  189. NAME"Temp.Data.info" AS "HouseInv.Data.info"
  190. NAME"Temp.Data" AS "HouseInv.Data"
  191. WINDOW CLOSE 3
  192. RecCnt=NewCnt:GOSUB PutRecCnt
  193. MRXit:
  194. GOTO MaintXit
  195.  
  196. ' Show Count of Records on File
  197. MRecCount:
  198. WINDOW 3,,(440,40)-(608,92),0,1
  199. COLOR Blu,Yel:CLS
  200. LOCATE 2,4:PRINT"Record Count"
  201. LOCATE 4,2:PRINT USING"Commited:  #####";RecCnt
  202. DrawGadgets InB%,InB%,bx(),bxtxt$()
  203. A%=InB%:B%=InB%:GOSUB WaitMouse
  204. WINDOW CLOSE 3
  205. GOTO MaintXit
  206.  
  207. ' Update Count File to Match Data File
  208. MUpdCount:
  209. GOSUB Opendata:IF ErrSw=1 THEN UCXit
  210. WINDOW 3,,(440,40)-(608,92),0,1
  211. COLOR Blu,Yel:CLS
  212. LOCATE 2,3:PRINT"Counting..."
  213. n=1
  214. UCGet:
  215. GET #1,n
  216. IF EOF(1) THEN UCDone
  217. n=n+1:GOTO UCGet
  218. UCDone:
  219. WINDOW CLOSE 3
  220. RecCount=n-1:GOSUB PutRecCnt
  221. UCXit:
  222. GOTO MaintXit
  223.  
  224. MaintXit:
  225. GOTO WaitHere
  226.  
  227. ' Help Routines (requested via Help Menu)
  228. ' ---------------------------------------
  229. DoHelp:
  230. WINDOW 4,,(408,0)-(631,186),0,1
  231. COLOR Blu,Yel:CLS:LOCATE 2,1
  232. ON i GOTO HlpGen,HlpInit,HlpReorg,HlpRecCnt,HlpUpdCnt
  233. HlpGen:
  234. PRINT" 'HouseInvMaint'  performs"
  235. PRINT" the necessary maintenance"
  236. PRINT" functions  on  the   data"
  237. PRINT" file      created      by"
  238. PRINT" 'HouseInv'.    It is  not"
  239. PRINT" concerned    with     the"
  240. PRINT" contents of the file, but"
  241. PRINT" rather   with  the   file"
  242. PRINT" itself.":PRINT" "
  243. PRINT" A     third      program,"
  244. PRINT" 'HouseInvPrint'  is  used"
  245. PRINT" to print reports based on"
  246. PRINT" the contents of the  data"
  247. PRINT" file."
  248. DrawGadgets HlpB%,HlpB%,bx(),bxtxt$()
  249. A%=HlpB%:B%=HlpB%:GOSUB WaitMouse
  250. GOTO HlpXit
  251. HlpInit:
  252. PRINT" This function,  available"
  253. PRINT" in this and the main pro-"
  254. PRINT" gram, allows you to start"
  255. PRINT" from scratch.":PRINT" "
  256. PRINT" The  main data file is  a"
  257. PRINT" random access file with a"
  258. PRINT" 'count'  file being  used"
  259. PRINT" to keep track of the num-"
  260. PRINT" ber of data records.":PRINT" "
  261. PRINT" 'Initialize'  causes  the"
  262. PRINT" data  file to be  deleted"
  263. PRINT" and the count file to  be"
  264. PRINT" reset to zero.":PRINT" "
  265. PRINT" It  should be  the  first"
  266. PRINT" function used."
  267. DrawGadgets HlpB%,HlpB%,bx(),bxtxt$()
  268. A%=HlpB%:B%=HlpB%:GOSUB WaitMouse
  269. GOTO HlpXit
  270. HlpReorg:
  271. PRINT" When records are  deleted"
  272. PRINT" they  remain in the  data"
  273. PRINT" file  with  a   'deleted'"
  274. PRINT" flag  turned  on.    When"
  275. PRINT" 'reviewed'  they show  up"
  276. PRINT" with '*' field separators"
  277. PRINT" and  may be  restored  by"
  278. PRINT" selecting them.":PRINT" "
  279. PRINT" 'Reorganize'  copies  the"
  280. PRINT" data  file  dropping  all"
  281. PRINT" deleted records.   There-"
  282. PRINT" fore,  after  reorganiza-"
  283. PRINT" tion, any previously del-"
  284. PRINT" eted  records  are   gone"
  285. PRINT" forever."
  286. DrawGadgets HlpB%,HlpB%,bx(),bxtxt$()
  287. A%=HlpB%:B%=HlpB%:GOSUB WaitMouse
  288. GOTO HlpXit
  289. HlpRecCnt:
  290. PRINT" 'Record  Count'  provides"
  291. PRINT" you  with a count of  the"
  292. PRINT" number  of records  pres-"
  293. PRINT" ently  in the data  file."
  294. PRINT" The  count  will  include"
  295. PRINT" any records that may have"
  296. PRINT" been  previously  deleted" 
  297. PRINT" if the file has not  been"
  298. PRINT" reorganized."
  299. DrawGadgets HlpB%,HlpB%,bx(),bxtxt$()
  300. A%=HlpB%:B%=HlpB%:GOSUB WaitMouse
  301. GOTO HlpXit
  302. HlpUpdCnt:
  303. PRINT" 'Update Count' counts the"
  304. PRINT" number of records in  the"
  305. PRINT" data file, and updates or"
  306. PRINT" creates  the  count  file"
  307. PRINT" with that number.":PRINT" "
  308. PRINT" Should  be used  only  if"
  309. PRINT" the   count   file    is "
  310. PRINT" deleted    or     becomes"
  311. PRINT" unreadable."
  312. DrawGadgets HlpB%,HlpB%,bx(),bxtxt$()
  313. A%=HlpB%:B%=HlpB%:GOSUB WaitMouse
  314. GOTO HlpXit
  315.  
  316. HlpXit:
  317. WINDOW CLOSE 4
  318. RETURN
  319.  
  320. ' Various Subprograms
  321. ' -------------------
  322. SUB Logo80 (Depth%) STATIC
  323. SHARED Blk,Blu,Grn,Cyn,Red,Mag,Yel,Wht
  324. IF First=0 THEN
  325.   First=1
  326.   SCREEN 1,640,200,Depth%,2
  327.   WINDOW 2,,,16,1
  328.   COLOR ,0:CLS
  329.   PALETTE 0,0,0,0  :Blk=0:'Black
  330.   PALETTE 1,0,0,1  :Blu=1:'Blue
  331.   PALETTE 2,0,.75,0:Grn=2:'Green
  332.   PALETTE 3,0,1,1  :Cyn=3:'Cyan
  333.   PALETTE 4,1,0,0  :Red=4:'Red
  334.   PALETTE 5,1,0,1  :Mag=5:'Magenta
  335.   PALETTE 6,1,.8,0 :Yel=6:'Yellow
  336.   PALETTE 7,1,1,1  :Wht=7:'White
  337. END IF
  338. COLOR ,Blk:CLS
  339. AREA(376,8):AREA STEP(64,0):AREA STEP(-20,16)
  340. AREA STEP(0,24):AREA STEP(-24,0):AREA STEP(0,-24)
  341. COLOR Blu:AREAFILL
  342. AREA(360,8):AREA STEP(32,0):AREA STEP(0,12)
  343. AREA STEP(-16,0):AREA STEP(0,4):AREA STEP(8,0):AREA STEP(0,8)
  344. AREA STEP(-8,0):AREA STEP(0,4):AREA STEP(24,0):AREA STEP(0,12)
  345. AREA STEP(-40,0):COLOR Grn:AREAFILL
  346. AREA(328,8):AREA STEP(24,0):AREA STEP(0,28)
  347. AREA STEP(24,0):AREA STEP(0,12):AREA STEP(-48,0)
  348. COLOR Red:AREAFILL
  349. AREA(272,8):AREA STEP(64,0):AREA STEP(0,12)
  350. AREA STEP(-20,0):AREA STEP(0,28):AREA STEP(-24,0):AREA STEP(0,-28)
  351. AREA STEP(-20,0):COLOR Cyn:AREAFILL
  352. AREA(264,8):AREA STEP(16,0):AREA STEP(24,40)
  353. AREA STEP(-16,0):AREA STEP(-8,-12):AREA STEP(-16,0):AREA STEP(-8,12)
  354. AREA STEP(-16,0):COLOR Mag:AREAFILL
  355. AREA(200,8):AREA STEP(56,0):AREA STEP(0,16)
  356. AREA STEP(-24,0):AREA STEP(0,-4):AREA STEP(-8,0):AREA STEP(0,16)
  357. AREA STEP(8,0):AREA STEP(0,-4):AREA STEP(24,0):AREA STEP(0,16)
  358. AREA STEP(-56,0):COLOR Yel:AREAFILL
  359. COLOR Blu,Blk:LOCATE 24,7
  360. PRINT"Bryan D. Catley  2221 Glasgow Road  Alexandria  Virginia  22307-1819";
  361. END SUB
  362.  
  363. SUB BldGadgets (Num,t1(),t2$()) STATIC
  364. FOR n=0 TO Num-1
  365.   FOR m=0 TO 6
  366.     READ t1(n,m)
  367.   NEXT m
  368.   READ t2$(n)
  369. NEXT n
  370. END SUB
  371.  
  372. SUB DrawGadgets (Ga%,Gb%,t1(),t2$()) STATIC
  373. FOR n=Ga% TO Gb%
  374.   x1=t1(n,0):y1=t1(n,1):x2=x1+t1(n,2):y2=y1+t1(n,3)
  375.   bg=t1(n,4):fg=t1(n,5):bo=t1(n,6)
  376.   LINE(x1,y1)-(x2,y2),bg,bf:LINE(x1,y1)-(x2,y2),fg,B
  377.   IF bo>-1 THEN
  378.     LINE(x1+2,y1+2)-(x2-2,y2-2),fg,B
  379.     LINE(x2+1,y1+1)-(x2+1,y2+1),bo
  380.     LINE(x2+1,y2+1)-(x1+1,y2+1),bo
  381.     COLOR fg,bg:row%=INT(y1/8+2):col%=INT(x1/8+2)
  382.     LOCATE row%,col%:PRINT t2$(n)
  383.   END IF
  384. NEXT n
  385. END SUB
  386.  
  387. SUB GetGadget (Ga%,Gb%,t1(),t2$(),type) STATIC
  388. SHARED MouseX%,mouseY%,MouseInd
  389. WHILE MOUSE(0)=0:WEND
  390. r%=CSRLIN:c%=POS(0)
  391. mx=MOUSE(1):my=MOUSE(2)
  392. MouseX%=mx:mouseY%=my:MouseInd=0
  393. FOR n=Ga% TO Gb%
  394.   IF mx>t1(n,0) AND mx<t1(n,0)+t1(n,2) THEN
  395.     IF my>t1(n,1) AND my<t1(n,1)+t1(n,3) THEN
  396.       bg=t1(n,4):fg=t1(n,5):bo=t1(n,6)
  397.       IF bo>-1 THEN
  398.         x1=t1(n,0)+2:y1=t1(n,1)+2
  399.         x2=x1+t1(n,2)-4:y2=y1+t1(n,3)-4
  400.         LINE(x1,y1)-(x2,y2),fg,bf
  401.         COLOR bg,fg:row%=INT(y1/8+2):col%=INT(x1/8+2)
  402.         LOCATE row%,col%:PRINT t2$(n)
  403.       ELSE
  404.         IF bo=-1 THEN
  405.           x1=t1(n,0):y1=t1(n,1):x2=x1+t1(n,2):y2=y1+t1(n,3)
  406.           LINE(x1,y1)-(x2,y2),fg,bf:LINE(x1,y1)-(x2,y2),bg,B
  407.         END IF
  408.       END IF
  409.       type=n-Ga%+1:n=Gb%:MouseInd=1
  410.       IF bo<-1 THEN 
  411.         n%=type+Ga%-1:DrawGadgets n%,n%,t1(),t2$()
  412.       END IF
  413.     END IF
  414.   END IF
  415. NEXT n
  416. WHILE MOUSE(0)<>0:WEND
  417. LOCATE r%,c%
  418. END SUB
  419.  
  420.